home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1995 November
/
EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso
/
earcd
/
dbase
/
scion409.lha
/
Scion409
/
ScionARexx.lha
/
Age.rexx
next >
Wrap
OS/2 REXX Batch file
|
1994-01-25
|
7KB
|
230 lines
/****************************************************************************/
/* */
/* Age.rexx */
/* */
/* Written by: Peter Billing, RMB 1240, Yinnar 3869, Australia */
/* */
/* Last saved: Wednesday 29-Sep-93 */
/* */
/* This script should tell you the Age of a person in the SCION database. */
/* It does except the date to be in the format DD MMM YYYY but as long as */
/* the year is the last 4 characters, it will give you an age within 1 year.*/
/* The database must be running for this AREXX script to work. */
/* */
/****************************************************************************/
/* Return the Database Name */
options results
/*test = show('P','SCIONGEN')
if test = 0 then
say
say "I am sorry to say that the SCION Genealogist database is not available."
say "Please start the SCION program BEFORE using this script."
say
exit */
myport = "SCIONGEN"
address value myport
getdbname
dbname = upper(result)
output = "STDOUT"
gettotalirn
total = result
say ""
say center("
Age.rexx
",80)
say
say "The current database is called" dbname "and it has "total "people in it."
say
say "This script will give you the correct age of a person who has a"
say "FULL birth date. If there is only a year or month and year you"
say "will get an approximate within a year. If there is also a death"
say "date, this will be used to calculate the persons age at death."
say "The script will then tell you how long the person has been dead."
say
writech(stdout,"Type in the IRN of the person you are interested in or ALL ")
pull irn
writech(output,"Output to Screen or File. S/F ")
pull out
if out = "" then out ="S"
L1 = 17
L2 = 13
code1 = "" /* Reverse video */
code2 = "" /* Normal Text */
code3 = "
" /* Bold text*/
code4 = "
" /* Italic text */
code5 = ""
if irn ~= "ALL" then do
if irn = "" | irn > total | irn < 1 then exit
end
number = "a person"
if irn = "ALL" then do
writech(stdout,"Do you want a sorted list Y/N ")
pull sorted
if sorted = "" then sorted = "N"
if sorted = "Y" then do
file_name = "ram:sort"
open(sort_File,file_Name,"w")
do a = 1 to total
getlastname a
person = upper(result)
getfirstname a
person = person result a
writeln(sort_File,person)
end
close(sort_file)
address command "c:sort ram:sort ram:sort2"
file_name = "ram:sort2"
open(sort_File,file_Name,"r")
end
start = 1
finish = total
number = "ALL people"
end
else do
start = irn
finish = irn
end
if out = "F" then do
filename = "RAM:Age_"irn"_"dbname".Scion"
open(w_file,filename,"w")
output = w_file
writeln(stdout,"")
writeln(stdout,"Writing file to" filename)
L1 = 25
L2 = 15
code1 = ""
code2 = ""
code3 = ""
code4 = ""
code5 = ""
end
heading = "List of "number" in the "dbname" database plus their age on "date()
day1 = subword(date(),1,1)
Month1 = subword(date(),2,1)
Year1 = subword(date(),3,1)
CheckMonth(upper(Month1)) /* turn the month into a number */
m1 = x
writeln(output,"w"center(heading,80))
writeln(output,"")
writeln(output,"-------------------------------------------------------------------------------")
do j = start to finish
if sorted = "Y" then do
person = readln(sort_file)
irn = word(person,words(person))
end
else do
irn = j
end
if out = "F" then do
if j/5 = j%5 then writech(stdout,".")
if j/55 = j%55 then do
writeln(output,"")
writeln(output,center(heading,80))
writeln(output,"")
writeln(output,"-------------------------------------------------------------------------------")
end
end
MakeName(irn)
person = name
fix = 0
birth = ""
getbirthdate irn
birth = result
if length(birth) > 3 then do /* check if there is a date */
day2 = word(birth,1) /* if there is then continue */
Month2 = substr(word(birth,2),1,3)
Year2 = substr(birth,length(birth)-3,4)
CheckMonth(upper(Month2))
m2 = x
end
else do /* no date */
writeln(output, right(irn,3) person code4"has no birth date."code2) /* say so */
fix = 1
end
if fix = 0 then do
death = ""
getdeathdate irn
death = result
if length(death) > 3 then do /* is if the person has a death date */
day3 = word(death,1) /* if there is a date then work out */
Month3 = word(death,2) /* age at death */
Year3 = substr(death,length(death)-3,4)
CheckMonth(upper(Month3))
m3 = x
age = year3 - year2
if m3 < m2 then age = age -1
if m3 = m2 then do
if day3 < day2 then age = age -1
end
getsex irn
if result == "M" then sex = "he "
else sex = "she"
if result == "" then sex = "they"
writeln(output, right(irn,3) person "was"code3 right(age,2)code2" when" sex "died" right(year1-year3,3) "year's ago on" death)
end
/* Person is still alive */
if length(death) < 3 & length(birth) > 3 then do /* check there is a bith date */
age = year1 - year2 /* work out the age using the year */
if m1 < m2 then /* if birth month is less than today */
age = age -1 /* then person is a year younger */
if m1 = m2 then do /* if the months are the same then */
/* check the days */
if day1 < day2 then do /* if birth day is less than today */
age = age -1 /* then person is a year younger */
end
end
if m1 = m2 & day1 = day2 then /* if day and month is the same as */
writeln(output, right(irn,3) person "is "code1 right(age,2)code2 "today."code5" Happy Birthday!!"code2)
else
if age < 106 then
writeln(output, right(irn,3) person "is "code1 right(age,2)code2 right(birth,14))
if age > 106 then
writeln(output,right(irn,3) person "has no death date and is over 105")
end
end
end
if out = "F" then do
writeln(output,"w")
close(w_file)
writeln(stdout,"")
writeln(stdout,"All Finished")
end
exit
/* end */
CheckMonth:
parse arg m
if m = "JAN" then x = 1
if m = "FEB" then x = 2
if m = "MAR" then x = 3
if m = "APR" then x = 4
if m = "MAY" then x = 5
if m = "JUN" then x = 6
if m = "JUL" then x = 7
if m = "AUG" then x = 8
if m = "SEP" then x = 9
if m = "OCT" then x = 10
if m = "NOV" then x = 11
if m = "DEC" then x = 12
return x
MakeName:
parse arg irn
getfirstname irn
name = left(result,L1)
getlastname irn
name = name left(result,L2)
return name